﻿/// /////////////////////////////////////////////
// 单元名 : unitTransProcObj
// 作者 : Hawk
// 单元描述 :
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitTransProcObj;

interface

uses unitObjBase, unitMsgObj, unitCommonDataStruct, unitAAACommon, unitLogStrList, unitLogCommon,
  unitTransactionBase, unitNetCommon, unitTransactionCommon, unitFileAndTransCommon, unitTransactionContent,
  unitSvrMngCommon, unitCommonTypes;

type
  TTransProcObj = class(TMajorObjBase)
  private
    FExecObj: TEXECOBJ_INFO;

    function CanAddTrans(pnt: TSerialObj; const sid, uid: TID_OBJ; var Obj, ExistObj: TSerialObj): ERRCODE;
    procedure GetAllTrans(rtbl: TStoreList; const ReqSource, ReqUID: TID_OBJ);
    procedure TransUpded(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure ReadTransFromConfigFile;
    procedure TransStatusChanged(Sender: TObject);
    procedure StartAllTrans;
    procedure ClearPairTrans;
    procedure CreatePairTrans(trans: TTransactionBase; const hid: TID_HOST);
    procedure DelPairTrans(trans: TTransactionBase; const hid: TID_HOST);
    procedure CheckTransValid;

    procedure ProcTimer(msg: TMsg);
    procedure ProcGetFuncInfo(msg: TMsg);
    procedure ProcNetQueryPorc(msg: TMsg);
    procedure ProFileQueryObj(msg: TMsg);
    procedure ProcTransMsg(msg: TMsg);
    procedure ProcRecordAdded(msg: TMsg);
  protected
    function DoProcessMsg(msg: TMsg): Boolean; override;
    procedure DoInit(DrationLastShutdowm: Longword); override;
    procedure DoInit2; override;
    procedure DoFinal; override;
  public
    class function ClassID: Longword; override;
    function IndependenceExecThread: Boolean; override;

  end;

implementation

uses Sysutils, unitMisc, unitObjPool, unitClassIDDef, unitCommonMsgProc, unitCommonIntf, unitUniqueDataCommon,
  unitErrCodeDef, unitCommonClasses, unitShareFileObjs;

const
  S_CONFIGFILENAME = 'Trans.config';

  { TTransProcObj }

function TTransProcObj.CanAddTrans(pnt: TSerialObj; const sid, uid: TID_OBJ; var Obj, ExistObj: TSerialObj): ERRCODE;
var
  so: TStringObj absolute Obj;
  tr: TTransactionBase;
begin
  Result := ERRCODE_NOERROR;
  case Obj.ClassID of
    CLASSID_STRINGOBJ:
      begin
        tr := ObjPool.GetObj(so.Flag, Self);
        if (tr <> nil) and tr.InheritsFrom(TTransactionBase) then
        begin
          tr.ObjID.GenericID(OBJTYPE_ID, IDSUBTYPE_RECORD);
          tr.ExecObj := @FExecObj;
          tr.CreatorID := sid;
          tr.CreateTime := Now;
          tr.ExpireTime := tr.CreateTime + 7;
          tr.Target := so.ObjID.IDDetail.SvrMdl.HostID;
          tr.Source := FullObjID.IDDetail.SvrMdl.HostID;
          tr.SetParam(so);
          tr.Caption := Format('将%s从%s发送到%s', [tr.TransContent, tr.Source.ToStr, tr.Target.ToStr]);
          tr.StartTrans;
        end
        else
        begin
          ObjPool.ReturnObj(tr, Self);
          Result := ERRCODE_CLASSNOTEXIST;
        end;
        ObjPool.ReturnObj(so, Self);
        Obj := tr;
      end;
  else
    if ExistObj = nil then
    begin
      Dbg('%s Create Trans: %s (%s)', [sid.ToString, Obj.Caption, S_BOOL[TTransactionBase(Obj).TransPair]]);
      TTransactionBase(Obj).ExecObj := @FExecObj;
      TTransactionBase(Obj).StartTrans;
    end
    else
      Result := ERRCODE_OBJEXIST;
  end;
end;

procedure TTransProcObj.CheckTransValid;
var
  tl: TStoreList;
  ti: TTransactionBase;
  d: TDateTime;
begin
  d := Now;
  tl := ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE);
  ti := TTransactionBase(tl.item[0]);
  while ti <> nil do
  begin
    if d > ti.ExpireTime then
      DelRecord(ti.ObjID);
    ti := TTransactionBase(ti.Next);
  end;
end;

class function TTransProcObj.ClassID: Longword;
begin
  Result := CLASSID_TRANSPROCOBJ;
end;

procedure TTransProcObj.ClearPairTrans;
var
  tr, tt: TTransactionBase;
begin
  tr := TTransactionBase(ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE).item[0]);
  while tr <> nil do
  begin
    tt := TTransactionBase(tr.Next);
    if tr.TransPair then
      ObjPool.ReturnObj(tr, Self);
    tr := tt;
  end;
end;

procedure TTransProcObj.CreatePairTrans(trans: TTransactionBase; const hid: TID_HOST);
var
  tr: TTransactionBase;
  so: TStringObj;
  m: TMsg;
begin
  if trans <> nil then
  begin
    tr := trans.CreatePairTrans(hid = trans.Target);
    if tr <> nil then
    begin
      m := GetAMsg;
      m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
      m.MsgID := MESID_UNIQUEDATA_ADDOBJ;
      so := m.AddIDObj(ID_RUNNINGTRANSACTIONTABLE);
      so.AddObj(tr);
      SendMsg(m);
    end;
  end;
end;

procedure TTransProcObj.DelPairTrans(trans: TTransactionBase; const hid: TID_HOST);
var
  m: TMsg;
begin
  if trans <> nil then
  begin
    m := GetAMsg;
    m.TargetObjID := MakeObjID(hid, UNIQUEDATAMODULE_ID);
    m.MsgID := MESID_UNIQUEDATA_DELOBJ;
    m.AddIDObj(trans.ObjID);
    SendMsg(m);
  end;
end;

procedure TTransProcObj.DoFinal;
begin
  Dbg('Enter TransProc Final;', L_DBGLEVEL_OUTPUT);
  ClearPairTrans;
  ObjPool.ReturnObj(FExecObj.AAAQuery, Self);
  FExecObj.AAAQuery := nil;
  ObjPool.ReturnObj(FExecObj.NetQuery, Self);
  FExecObj.NetQuery := nil;
  ObjPool.ReturnObj(FExecObj.FileQuery, Self);
  FExecObj.FileQuery := nil;
  Dbg('Leave TransProc Final;', L_DBGLEVEL_OUTPUT);
  inherited;
end;

procedure TTransProcObj.DoInit(DrationLastShutdowm: Longword);
var
  s: CommonString;
begin
  Dbg('Enter TransProc Init;', L_DBGLEVEL_OUTPUT);
  ReqAAAQueryObj;
  s := GetStorePath(True);
  RegTableCB(ID_RUNNINGTRANSACTIONTABLE, S_RUNNINGTRANSACTIONTABLE, s + S_CONFIGFILENAME, TStoreList, nil, GetAllTrans,
    CanAddTrans, nil, nil, TransUpded, nil);
  SendMsgToObj(OBJID_FILEANDTRANSMODULE, MESID_FILETRANS_GETQUERYOBJ);
  SendMsgToObj(OBJID_SVRMODULE, MESID_NET_GETQUERYOBJ);
  // AddStoreFileToDC(FTransactions);
  // FRunningTransTable.CanAddRecord := CanAddTrans;
  // FRunningTransTable.GetRecords := GetAllTrans;
  // FRunningTransTable.AddRdUpdated(TransUpded);
  FExecObj.ProcObj := Self;
  FExecObj.OnTransStatusChanged := TransStatusChanged;
  FExecObj.ImRoot := FullObjID.IDDetail.SvrMdl.HostID = HOSTID_ROOT;
  Dbg('Leave TransProc Init;', L_DBGLEVEL_OUTPUT);
  inherited;
end;

procedure TTransProcObj.DoInit2;
begin
  ReadTransFromConfigFile;
  InitResource(ID_RUNNINGTRANSACTIONTABLE, MASK_ALL, 0, S_RUNNINGTRANSACTIONTABLE);
  InitPriorityAllOpe(ID_RUNNINGTRANSACTIONTABLE, MASK_LOCALALLUID, S_RUNNINGTRANSACTIONTABLE);
  InitPriorityAllOpe(ID_RUNNINGTRANSACTIONTABLE, MASK_LOCALUI, S_RUNNINGTRANSACTIONTABLE);
  if FExecObj.ImRoot then
  begin
    AddHostFunc(ID_ROOTSWAPPATH, S_ROOTSWAPPATH, '', S_ROOTSWAPPATH, vtPath);
    InitResource(ID_ROOTSWAPPATH, MASK_ALL, 0, S_ROOTSWAPPATH);
    InitPriorityAllOpe(ID_ROOTSWAPPATH, MASK_LOCALALLUID, S_ROOTSWAPPATH);
    InitPriorityAllOpe(ID_ROOTSWAPPATH, MASK_LOCALUI, S_ROOTSWAPPATH);
  end;
  GetRecord(ID_DOWNLOADINGTABLE);
  FocusResource(HOSTID_LOCAL, [ID_REGEDDEVTABLE]);
  StartAllTrans;
  inherited;
end;

function TTransProcObj.DoProcessMsg(msg: TMsg): Boolean;
var
  tl: TStoreList;
  tb: TTransactionBase;
begin
  Result := True;
  case msg.MsgID of
    MESID_ALL_GETFUNCTION_INFO:
      ProcGetFuncInfo(msg);
    MESID_ALL_TIMER:
      ProcTimer(msg);
    MESID_ALL_ONTIMER_SAVECONFIG:
      CheckTransValid;
    MESID_NET_SENDQUERYOBJ:
      ProcNetQueryPorc(msg);
    MESID_FILETRANS_RETURNQUERYOBJ:
      ProFileQueryObj(msg);
    MESID_UNIQUEDATA_ADDOBJ:
      ProcRecordAdded(msg);
  else
    case msg.MsgID of
      MESID_TRANSACTION_STARTTRANS, MESID_TRANSACTION_PAUSETRANS, MESID_TRANSACTION_STOPTRANS,
        MESID_TRANSACTION_DELTRANS, MESID_TRANSACTION_PAIRCOMPLETE, MESID_TRANSACTION_PAIRCOMPLETE_CONFIRM:
        ProcTransMsg(msg);
    else
      if MajorObjStatus = mosNormal then
      begin
        tl := ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE);
        if tl <> nil then
        begin
          tb := TTransactionBase(tl.item[0]);
          while tb <> nil do
          begin
            tb.ProcTransMsg(msg);
            tb := TTransactionBase(tb.Next);
          end;
        end;
      end;
      inherited;
      if msg.MsgID = MESID_AAA_SENDQUERYPROC then
        FExecObj.AAAQuery := AAAQuery;
    end;
  end;
end;

procedure TTransProcObj.GetAllTrans(rtbl: TStoreList; const ReqSource, ReqUID: TID_OBJ);
var
  tr: TTransactionBase;
  h: TID_HOST;
begin
  h := FullObjID.IDDetail.SvrMdl.HostID;
  tr := TTransactionBase(ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE).item[0]);
  while tr <> nil do
  begin
    if (tr.Source = h) or (tr.Target = h) then
      rtbl.AddObj(tr.Clone(False));
    tr := TTransactionBase(tr.Next);
  end;
end;

function TTransProcObj.IndependenceExecThread: Boolean;
begin
  Result := True;
end;

procedure TTransProcObj.ProcGetFuncInfo(msg: TMsg);
var
  F: TFuncInfo;
begin
  F := TFuncInfo(ObjPool.GetObj(TFuncInfo, Self));
  if F <> nil then
  begin
    // F.FuncOrOperID := CLASSID_LOGSERVEROBJ shl 8;
    F.FuncOrOperDesc := '  ־      ';
    ReturnMsg(msg, MESID_ALL_RETURNFUNC_INFO, F);
  end;
end;

procedure TTransProcObj.ProcNetQueryPorc(msg: TMsg);
begin
  ObjPool.ReturnObj(FExecObj.NetQuery, Self);
  FExecObj.NetQuery := msg.Param(TNetQueryObj);
  msg.DelObj(FExecObj.NetQuery);
end;

procedure TTransProcObj.ProcRecordAdded(msg: TMsg);
var
  tl: TStoreList;
  Obj: TSerialObj;
  so: TStringObj;
  tr: TTransactionBase;
begin
  so := msg.Param(TStringObj);
  tl := ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE);
  if (so <> nil) and (tl <> nil) then
    if (so.ObjID = ID_RUNNINGTRANSACTIONTABLE) then
    begin
      if msg.Error = ERRCODE_NOERROR then
      begin
        while so.Count > 0 do
        begin
          Obj := so.Obj[0];
          tr := TTransactionBase(tl.item[0]);
          while tr <> nil do
          begin
            tr.RecordAdded(msg.SourceObjID, msg.ObjID, so.ObjID, Obj, msg.Error);
            tr := TTransactionBase(tr.Next);
          end;
          ObjPool.ReturnObj(Obj, Self);
        end;
      end
      else
      begin
        Obj := msg.Obj[0];
        tr := TTransactionBase(tl.item[0]);
        while tr <> nil do
        begin
          tr.RecordAdded(msg.SourceObjID, msg.ObjID, EMPTY_ID_OBJ, Obj, msg.Error);
          tr := TTransactionBase(tr.Next);
        end;
        ObjPool.ReturnObj(Obj, Self);
      end;
    end
    else if msg.ObjID = ID_REGEDDEVTABLE then
    begin

    end;
end;

procedure TTransProcObj.ProcTimer(msg: TMsg);
var
  tr: TTransactionBase;
  m: TMsg;
begin
  tr := TTransactionBase(ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE).item[0]);
  while tr <> nil do
  begin
    if tr.Status <> tsComplete then
    begin
      tr.Clock(msg.Data);
      case tr.Status of
        tsWaitTgtOnLine:
          if tr.IsDataReady then
            case FExecObj.NetQuery.QueryRouteStatus(tr.Target) of
              hsNone:
                if (tr.StatusTick >= I_MESSTOROOT) and (tr.TransDataLen <= L_MESSDATALEN) then
                  CreatePairTrans(tr, HOSTID_ROOT)
                else if (tr.StatusTick > I_MASSTOROOT) then
                  CreatePairTrans(tr, HOSTID_ROOT);
              hsByRoot:
                if (tr.TransDataLen <= L_MASSDATALEN) then
                  CreatePairTrans(tr, tr.Target)
                else
                  CreatePairTrans(tr, HOSTID_ROOT);
              hsDirect:
                CreatePairTrans(tr, tr.Target);
            end;
        tsWaitUIConfim:
          SendMsgToObj(OBJID_UNIQUEDATAMODULE, ID_RUNNINGTRANSACTIONTABLE, MESID_UNIQUEDATA_FOCUSNOTIFY);
        tsPairTransComp:
          case FExecObj.NetQuery.QueryRouteStatus(tr.CreatorID.IDDetail.SvrMdl.HostID) of
            hsByRoot, hsDirect:
              begin
                m := GetAMsg;
                m.TargetObjID := tr.CreatorID;
                m.MsgID := MESID_TRANSACTION_PAIRCOMPLETE;
                m.ObjID := tr.ObjID;
                m.Error := tr.TargetErrCode;
                SendMsg(m);
              end;
          end;
        tsComplete:
          begin
            if tr.RootPairReqed then
              DelPairTrans(tr, HOSTID_ROOT);
            if tr.TargetPairReqed then
              DelPairTrans(tr, tr.Target);
          end;
      end;
    end;
    if Now > tr.ExpireTime then
      tr.StopTrans;
    tr := TTransactionBase(tr.Next);
  end;
end;

procedure TTransProcObj.ProcTransMsg(msg: TMsg);
var
  tr: TTransactionBase;
  os: TTransactionStatus;
begin
  tr := TTransactionBase(ObjTree.FindObjExcept(msg.ObjID, CLASSID_PRIORITYOBJ));
  if tr <> nil then
  begin
    os := tr.Status;
    case msg.MsgID of
      MESID_TRANSACTION_STARTTRANS:
        tr.StartTrans;
      MESID_TRANSACTION_PAUSETRANS:
        tr.PauseTrans;
      MESID_TRANSACTION_STOPTRANS:
        tr.StopTrans;
      MESID_TRANSACTION_DISMISSTRANS:
        tr.UIConfirmed;
      MESID_TRANSACTION_PAIRCOMPLETE:
        tr.PairComplete(msg.SourceObjID.IDDetail.SvrMdl.HostID, msg.Error);
      MESID_TRANSACTION_PAIRCOMPLETE_CONFIRM:
        tr.ConfirmPairComplete(msg.SourceObjID.IDDetail.SvrMdl.HostID);
    else
      tr.ProcTransMsg(msg);
    end;
    if os <> tr.Status then
      NotifyRecordUpdated([tr.ObjID]);
  end;
end;

procedure TTransProcObj.ProFileQueryObj(msg: TMsg);
begin
  ObjPool.ReturnObj(FExecObj.FileQuery, Self);
  FExecObj.FileQuery := msg.Param(TFileQueryObj);
  msg.DelObj(FExecObj.FileQuery);
end;

procedure TTransProcObj.ReadTransFromConfigFile;
var
  tl: TStoreList;
  tr: TTransactionBase;
begin
  tl := ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE);
  if tl <> nil then
  begin
    tr := TTransactionBase(tl.item[0]);
    while tr <> nil do
    begin
      tr.ExecObj := @FExecObj;
      if tr.TransPair then
        Dbg('%s is pair', [tr.Caption]);
      tr := TTransactionBase(tr.Next);
    end;
  end;
end;

procedure TTransProcObj.StartAllTrans;
var
  tl: TStoreList;
  tr: TTransactionBase;
begin
  if (FExecObj.NetQuery <> nil) and (FExecObj.FileQuery <> nil) then
  begin
    tl := ObjTree.FindTable(ID_RUNNINGTRANSACTIONTABLE);
    tr := TTransactionBase(tl.item[0]);
    while tr <> nil do
    begin
      tr.StartTrans;
      tr := TTransactionBase(tr.Next);
    end;
  end;
end;

procedure TTransProcObj.TransStatusChanged(Sender: TObject);
var
  tr: TTransactionBase absolute Sender;
begin
  NotifyRecordUpdated([tr.ObjID]);
end;

procedure TTransProcObj.TransUpded(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
var
  tb: TTransactionBase absolute Obj;
begin
end;

initialization

ObjPool.RegisterObjClass(TTransProcObj);

end.
